Code
library(tidyverse)
library(scales)library(tidyverse)
library(scales)# generative dataframe (polar)
# similar to workshop materials, but changed parameters a bit
set.seed(2538)
n <- 100
dat <- tibble(
x0 = runif(n),
y0 = runif(n),
x1 = x0 + runif(n, min = -.5, max = .5),
y1 = y0 + runif(n, min = -.5, max = .5),
shade = runif(n), # for random colors
size = runif(n) # for random linewidths
)# This function generates a palette of n random distinct colors
my_pal_generator <- function(seed = NULL, n) {
if(!is.null(seed)) set.seed(seed)
sample(colours(distinct = TRUE), size = n, replace = FALSE)
}
gen_pal <- my_pal_generator(seed = 7, n = 4)
show_col(gen_pal) # displays the color palette # Sample from Canva palettes, code is from workshop materials
sample_canva <- function(seed = NULL) {
if(!is.null(seed)) set.seed(seed)
sample(ggthemes::canva_palettes, 1)[[1]]
}
pal <- sample_canva(seed = 233)
show_col(pal) # displays the Canva color palette# Function to create a polar-styled plot with ggplot, user just needs plotting data and a palette
# is the "ggplot base" and then you can add geoms after using this function
polar_styled_plot <- function(data = NULL, palette) {
ggplot(
data = data,
mapping = aes(
x = x0,
y = y0,
xend = x1,
yend = y1,
colour = shade,
size = size
)) +
coord_polar(clip = "off") +
scale_y_continuous(
expand = c(0, 0),
limits = c(0, 1),
oob = scales::oob_keep
) +
scale_x_continuous(
expand = c(0, 0),
limits = c(0, 1),
oob = scales::oob_keep
) +
scale_colour_gradientn(colours = palette) +
scale_size(range = c(0, 10)) +
theme_void() +
guides(
colour = guide_none(),
size = guide_none(),
fill = guide_none(),
shape = guide_none()
)
}polar_styled_plot(palette = sample_canva(seed = 2461)) +
geom_segment(data = dat) +
geom_segment(data = dat |> mutate(y1 = y1 - .4, y0 = y0 - 0.4)) +
geom_segment(data = dat |> mutate(y1 = y1 - .3, y0 = y0 - .3)) +
geom_segment(data = dat |> mutate(y1 = y1 * 1.75, y0 = y0 * 1.75)) First, we’ll load in some customized plotting functions
polar_art <- function(seed, n, palette) {
# set the state of the random number generator
set.seed(seed)
# data frame containing random values for
# aesthetics we might want to use in the art
dat <- tibble(
x0 = runif(n),
y0 = runif(n),
x1 = x0 - runif(n, min = -.3, max = .3),
y1 = y0 +- runif(n, min = -.4, max = .4),
shade = runif(n),
size = runif(n)
)
# plot segments in various colours, using
# polar coordinates and a gradient palette
dat |>
ggplot(aes(
x = x0,
y = y0,
xend = x1,
yend = y1,
colour = shade,
size = size
)) +
geom_segment(show.legend = FALSE) +
coord_polar() +
scale_y_continuous(expand = c(0, 0)) +
scale_x_continuous(expand = c(0, 0)) +
scale_colour_gradientn(colours = palette) +
scale_size(range = c(0, 10)) +
theme_void()
}# To install the latest version of rayshader from Github:
# install.packages("devtools")
# devtools::install_github(repo = "https://github.com/tylermorganwall/rayshader.git")
library(rayshader)
library(tibble)
library(ambient)
library(dplyr)
library(ggplot2)
library(ggthemes)
library(tictoc)
library(dplyr)Simplex Noise Function
# the purpose of this function is to give us a noise function that we can use to generate *textures*!
# the inputted values are `x` and `y` coordinates, a `frequency` for the noise, and the number of `octaves` to use in the noise generation.
# The noise is discontinuous offsets of the x and y coordinates, which are then those textures in the image
simplex_noise <- function(x, y, frequency = .1, octaves = 10) {
fracture(
noise = gen_simplex,
fractal = ridged,
octaves = octaves,
frequency = frequency,
x = x,
y = y
) |>
normalise()
}# function necessary to create curl noise
# needed for Ice Floe system
# an octave represents a layer of noise
transform_to_curl_space <- function(x, y, frequency = 1, octaves = 10) {
curl_noise(
generator = fracture,
noise = gen_simplex,
fractal = fbm,
octaves = octaves,
frequency = frequency,
x = x,
y = y
)
}Worley cell function
# frequency = number of points/cells that the function uses to create noise
# octave = number of layers of noise desired
define_worley_cells <- function(x, y, frequency = 3, octaves = 6) {
fracture(
noise = gen_worley,
fractal = billow,
octaves = octaves,
frequency = frequency,
value = "cell",
x = x,
y = y
) |>
rank() |>
normalise()
}Shaded ice floe function - Ice floes are pieces that “have a jagged, fractured geometric look to them” according to the workshop materials.
ice_floe <- function(seed) {
set.seed(seed)
# create a grid of points in the unit square
grid <- long_grid(
x = seq(0, 1, length.out = 2000),
y = seq(0, 1, length.out = 2000)
)
# create curl texture
coords <- transform_to_curl_space(grid$x, grid$y,
frequency = 2, octaves = 2)
# create worley noise and output as array
grid |>
mutate(
cells = define_worley_cells(coords$x, coords$y,
frequency = 5,
octaves = 7),
paint = simplex_noise(x + cells, y + cells),
paint = normalise(paint)
) |>
as.array(value = paint)
}# my desired palette, us
dune_pal <- c("#7c593a",
# from poster 2
"#fbcf73","#f6911f", "#b17c43", "#8d572a")
# Create a dune-color based gradient palette
dune_pal_generator <- function(seed = NULL, n, pal) {
if(!is.null(seed)) set.seed(seed)
pal_fn <- colorRampPalette(pal)
pal_fn(n)
}Here’s the plot, using shading tricks.
shaded_ice_floe <- function(seed) {
art <- ice_floe(seed) # create ice floe texture
height_shade(
heightmap = art, # heights created by ice floe
texture = dune_pal_generator(seed, pal = dune_pal, n = 256) # use my dune pal
) |>
# adding shadow using ice floe
add_shadow(
shadowmap = ray_shade(
heightmap = art,
sunaltitude = 20,
sunangle = 100,
multicore = TRUE,
zscale = .01
),
max_darken = .075
) |>
plot_map()
}
shaded_ice_floe(892)dune_texture <- create_texture(
lightcolor = "#e0c16c",
shadowcolor = "#7d2a06",
leftcolor = "#e6cf78",
rightcolor = "#cc9129",
centercolor = "#e0c872"
)
seed <- 13239587
ice_height <- matrix(0, 2500, 2500) # a matrix of elevations
ice_height[251:2250, 251:2250] <- ice_floe(seed)
ice_scape <- sphere_shade(
heightmap = ice_height,
texture = dune_texture # my custom color scale
) |>
add_shadow(
shadowmap = ray_shade(
heightmap = ice_height,
sunaltitude = 30,
sunangle = 90,
multicore = TRUE,
zscale = .005
),
max_darken = .15
)
# create 3d version with ice_floe shading and elevation matrix
plot_3d(
hillshade = ice_scape,
heightmap = ice_height,
theta = 45,
phi = 30,
zoom = .75,
zscale = .001,
background = "#222222",
shadow = FALSE,
soliddepth = .5,
solidcolor = "#222222",
windowsize = c(2500, 1500)
)
# create png of 3D image
render_snapshot(
filename = here::here("images","exhibit2.png"),
clear = TRUE
)
# display png
knitr::include_graphics(here::here("images","exhibit2.png"))